home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ledt.arc / LE-D&T.PAS < prev   
Pascal/Delphi Source File  |  1986-02-27  |  5KB  |  183 lines
  1. {  LE-D&T.PAS   Leading Edge Date & Time Program.  For model M (same as
  2.    Sperry PC), I don't know about the "D" model.
  3.                        Craig Roberts,  (612) 699-4404
  4.  
  5.     When I upgraded to a hard disk, I went to PC-DOS 3.1 to gain the
  6.     SUBST command.  However, I lost the LE-modified MS-DOS which reads
  7.     the LE clock.  So, I wrote this program so I can boot from the hard
  8.     disk and not have to enter the date & time.  LE-D&T reads the clock
  9.     according to the hardware spec in the LE manual.  No, it doesn't
  10.     allow you to update the clock.  Throw your old MS-DOS in the A drive,
  11.     the enter the date & time like the MS manual says.
  12.  
  13.   Operation:
  14.    The following program uses the MsDos command in Turbo to
  15.    retrieve the system date.  This is achieved via DOS function
  16.    call 42 (or 2A hex).  The function call is placed in the AH
  17.    register according to the technical reference manual.  The
  18.    tricky places are the delays, provided by the delay function.
  19.    There are probably more elegent ways to program, but it works.
  20.  
  21.   Update History
  22.    Modified by Craig   11/16/85 !!!!
  23.    *}
  24.  
  25. program datetime;
  26. type
  27.   string10 = string[10];
  28.   TimeStr = string10;
  29.   DateStr = string10;
  30.  
  31. Var
  32.   Sec, Hour,Min,AM_PM,Month,Day,Year: String[2];
  33.   Sc,  Hr,  Mi, Wd,   Mo,   Da, Yr : integer ;
  34.   Regs: Record Case Integer Of
  35.                 1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags: Integer);
  36.                 2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  37.               End;
  38.   tyme : timestr ;
  39.   dayte : datestr ;
  40. Const
  41.   WeekDay : array [0..6] of string10 =
  42.           ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday',
  43.            'Saturday');
  44.  
  45.  
  46. Procedure ZeroFill(Var S: String10);
  47.   Var
  48.     I: Integer;
  49.   Begin
  50.     For I:=1 To Length(S) Do If S[I]=' ' Then S[I]:='0';
  51.   End;
  52.  
  53. function Time: TimeStr;
  54. begin
  55.     With Regs Do
  56.      Begin
  57.       AH:=$2C;
  58.       Flags:=0;
  59.       MsDos(Regs);
  60.       AM_PM:='am';
  61.       If CH>11 Then
  62.        Begin
  63.         CH:=CH-12;
  64.         AM_PM:='pm';
  65.        End;
  66.       If CH=0 Then CH:=12;
  67.       Str(CH:2,Hour);
  68.       Str(CL:2,Min);
  69.       Tyme:=Hour+':'+Min+AM_PM;
  70.       ZeroFill(Tyme);
  71.  
  72.      End; { With Regs }
  73.   time := tyme ;
  74. end; { time  }
  75.  
  76. procedure getLeDaTime ;  { from LE clock  }
  77. const LEclcal   = $2A2 ;
  78.       dataRead  = $40 ;
  79.       busyRead  = $10 ;
  80.       addrWrite = $80 ;
  81.       S1Addr    = $00 ;
  82.       S10Addr   = $01 ;
  83.       Mi1Addr   = $02 ;
  84.       Mi10Addr  = $03 ;
  85.       H1Addr    = $04 ;
  86.       H10Addr   = $05 ;
  87.       WAddr     = $06 ;
  88.       D1Addr    = $07 ;
  89.       D10Addr   = $08 ;
  90.       Mo1Addr   = $09 ;
  91.       Mo10Addr  = $0A ;
  92.       Y1Addr    = $0B ;
  93.       Y10Addr   = $0C ;
  94. var   DataByte : byte ;
  95.  
  96. function ReadOperation (Addr : byte ) : byte ;
  97. begin
  98. { addr write  }
  99.   port[LEclCal] := addrWrite or addr ;
  100.   delay (1);
  101.   port[LEclCal] := addr ;
  102.  
  103.   repeat
  104.     if keypressed then halt ;
  105.     port[LEclCal] := dataRead ;
  106.     delay(2);  { >1.5 msec  }
  107.     dataByte := port[LEclCal] ;
  108.   until (DataByte and busyRead  ) <> 0 ;
  109.   ReadOperation := dataByte and $0F ;
  110.   port[LEclCal] := $00 ;
  111.  
  112. end ; { waitnotBusy  }
  113.  
  114. begin { getTime  }
  115.   Sc := ReadOperation(S10Addr)*10 + ReadOperation(S1Addr) ;
  116.   Mi := ReadOperation(Mi10Addr) * 10 + ReadOperation(Mi1Addr) ;
  117.   Hr :=  (ReadOperation(H10Addr) and $03) * 10 + ReadOperation(H1Addr) ;
  118.   Wd :=  readOperation(WAddr) ;
  119.   Da := readOperation(D10Addr) * 10 + readOperation(D1Addr) ;
  120.   Mo :=  readOperation(Mo10Addr) * 10 + readoperation(Mo1Addr) ;
  121.   Yr :=  readOperation(y10Addr) * 10 + 1980 + ReadOperation(Y1Addr) ;
  122. end ; { getLeDaTime  }
  123.  
  124. procedure setDosDaTime ;
  125. begin
  126. {  writeln('Date :',mo:3,da:3,yr:3,Wd:5);}
  127.   with Regs do
  128.    begin
  129.      CX := Yr ;
  130.      DL := Da ;
  131.      DH := Mo ;
  132.      AL := Wd ;
  133.      AH:=$2B;
  134.      Flags:=0;
  135.      MsDos(Regs);
  136.    end;
  137. {  writeln('Time :',hr:3,mi:3,sc:3);}
  138.   with Regs do
  139.    begin
  140.      CH := Hr ;
  141.      CL := Mi ;
  142.      DH := Sc ;
  143.      DL := 00 ;
  144.      AH := $2D ;
  145.      Flags:=0;
  146.      MsDos(Regs);
  147.    end;
  148. end;
  149.  
  150. function Date: DateStr;
  151.  
  152. begin
  153.   with Regs do
  154.    begin
  155.       AH:=$2A;
  156.       Flags:=0;
  157.       MsDos(Regs);
  158.       Str((CX Mod 100):2,Year);
  159.       Str(DL:2,Day);
  160.       Str(DH:2,Month);
  161.       Dayte:=Month+'/'+Day+'/'+Year;
  162.       ZeroFill(Dayte);
  163.    end;
  164.   date := dayte ;
  165. end;  { date  }
  166.  
  167. function setWhite : string10 ; begin TextColor(White); setWhite := ''; end;
  168. function setRedBack : string10 ;
  169.      begin TextBackground(red); setRedBack := ''; end;
  170. function setBlackBack : string10 ;
  171.      begin TextBackground(Black); setBlackBack := ''; end;
  172.  
  173. begin
  174.   getLeDaTime ;
  175.   setDosDaTime ;
  176.   writeln;
  177.   writeln;
  178.   writeln(setWhite,'╒',setRedBack,' DateTime 1.01 ',
  179.                       setBlackBack,'══════════════════════════╕');
  180.   writeln(setWhite,'│                                         │');
  181.   writeln(setWhite,'│ It is now ',weekday[Wd]:9,',  ',date,'  ', time, ' │');
  182.   writeln(setWhite,'└─────────────────────────────────────────┘');
  183. end.